home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Mathematics / Notebooks / SigProc2.0 / Packages / SignalProcessing / ObjectOriented / Slot.m < prev    next >
Encoding:
Text File  |  1992-08-18  |  9.6 KB  |  312 lines
  1. (*  :Title:    Object-Oriented Extensions  *)
  2.  
  3. (*  :Authors:    Brian Evans, James McClellan  *)
  4.  
  5. (*  :Summary:    To implement slots and methods in Mathematica  *)
  6.  
  7. (*  :Context:    SignalProcessing`ObjectOriented`Slot`  *)
  8.  
  9. (*  :PackageVersion:  2.7    *)
  10.  
  11. (*
  12.     :Copyright:    Copyright 1989-1991 by Brian L. Evans
  13.         Georgia Tech Research Corporation
  14.  
  15.     Permission to use, copy, modify, and distribute this software
  16.     and its documentation for any purpose and without fee is
  17.     hereby granted, provided that the above copyright notice
  18.     appear in all copies and that both that copyright notice and
  19.     this permission notice appear in supporting documentation,
  20.     and that the name of the Georgia Tech Research Corporation,
  21.     Georgia Tech, or Georgia Institute of Technology not be used
  22.     in advertising or publicity pertaining to distribution of the
  23.     software without specific, written prior permission.  Georgia
  24.     Tech makes no representations about the suitability of this
  25.     software for any purpose.  It is provided "as is" without
  26.     express or implied warranty.
  27.  *)
  28.  
  29. (*  :History:    *)
  30.  
  31. (*  :Keywords:    *)
  32.  
  33. (*  :Source:    *)
  34.  
  35. (*  :Warning:    *)
  36.  
  37. (*  :Mathematica Version:  1.2 or 2.0  *)
  38.  
  39. (*  :Limitation:  *)
  40.  
  41. (*
  42.     :Discussion:  Internally, slots and methods are represented as collection
  43.             of delayed substitution rules (slot :> value).
  44.           In order to determine the value of a slot, recursive
  45.             application of the rule base is used so that the
  46.             value of a slot can rely on the value of other slots
  47.             in the same object.
  48.           Length will return the number of slots in the object.
  49.  *)
  50.  
  51. (*
  52.     :Functions:      AddSlot
  53.           AppendSlot
  54.           DefaultSlot
  55.           DefineObjectType
  56.           DeleteSlot
  57.           HasSlotQ
  58.           MakeObject
  59.           ReadSlot
  60.           WriteSlot
  61.  *)
  62.  
  63.  
  64.  
  65. (*  B E G I N     P A C K A G E  *)
  66.  
  67. BeginPackage [ "SignalProcessing`ObjectOriented`Slot`",
  68.            "SignalProcessing`ObjectOriented`StackQueue`",
  69.            "SignalProcessing`Support`SupCode`" ]
  70.  
  71.  
  72. If [ TrueQ[ $VersionNumber >= 2.0 ],
  73.      Off[ General::spell ];
  74.      Off[ General::spell1 ] ];
  75.  
  76.  
  77. (*  U S A G E     I N F O R M A T I O N  *)
  78.  
  79. AddSlot::usage =
  80.     "AddSlot[object, writeflag, slot, initvalue] adds the slot to \
  81.     object, where object (a symbol assigned to the object's value) \
  82.     is mutated; initvalue is the initial value assigned to this \
  83.     new slot and writeflag is True if the slot can be overwritten. \
  84.     The object is returned if the slot slot already exists. \
  85.     Note that initvalue can be a collection of values like 1,2,3."
  86.  
  87. AKindOf::usage =
  88.     "AKindOf is a slot that describes the class to which \
  89.     the object belongs."
  90.  
  91. AppendSlot::usage =
  92.     "AppendSlot[object, slot, appendfun, addvalue] will set the \
  93.     value of the slot slot in object to the value returned by \
  94.     calling appendfun with two arguments:  the old value of the \
  95.     slot and addvalue. \
  96.     Note that object is an unevaluated symbol and that addvalue \
  97.     can be a collection of values like 1,2,3."
  98.  
  99. DefaultSlot::usage =
  100.     "DefaultSlot[object_tag, slot, value] will set up the value as the \
  101.     default for the slot in any object with a tag of object_tag. \
  102.     For example, to set up 0 as the default value for the slot \
  103.     CurrentValue of a Signal, use DefaultSlot[Signal, CurrentValue, 0]."
  104.  
  105. DefineObjectType::usage =
  106.     "DefineObjectType[object, parent_object] clears the attributes \
  107.     of object and sets the HoldRest attribute."
  108.  
  109. DeleteSlot::usage =
  110.     "DeleteSlot[object, slot] removes the slot slot from object and \
  111.     returns the new object. \
  112.     Note that object is an unevaluated symbol."
  113.  
  114. HasSlotQ::usage =
  115.     "HasSlotQ[object, slot] returns True if the slot slot exists \
  116.     in object."
  117.  
  118. MakeObject::usage =
  119.     "MakeObject[object] returns a packet of data tagged with object. \
  120.     Note that an object must at most have the attribute of HoldRest. \
  121.     See DefineObjectType."
  122.  
  123. ReadOnlyList::usage =
  124.     "ReadOnlyList is the slot which keeps track of the slots/methods \
  125.     which can not be altered."
  126.  
  127. ReadOnlySlotQ::usage =
  128.     "ReadOnlySlotQ[object, slot_or_method] returns True if the \
  129.     slot_or_method can not be altered in the object."
  130.  
  131. ReadSlot::usage =
  132.     "ReadSlot[object, slot] returns the contents of the slot slot \
  133.     in object. \
  134.     Note that object is an unevaluated symbol."
  135.  
  136. WriteSlot::usage =
  137.     "WriteSlot[object, slot, value] attempts to write over the slot \
  138.     slot in object. \
  139.     If the slot slot is read-only, then object is returned unaltered. \
  140.     If the slot is not write protected, then the slot slot in object \
  141.     is overwritten with value. \
  142.     Note that object is an unevaluated symbol and that a slot value \
  143.     cannot be a collection of values like (1, 2, 3)."
  144.  
  145. (*  E N D     U S A G E     I N F O R M A T I O N  *)
  146.  
  147.  
  148. Begin[ "`Private`" ]
  149.  
  150.  
  151. (*  M E S S A G E S  *)
  152.  
  153. AddSlot::slotexists = "The slot `` already exists in the `` object."
  154. DeleteSlot::slotmissing = "The slot `` is missing in a `` object."
  155. DeleteSlot::slotprotected = "The slot `` can not be deleted in a `` object."
  156. ReadSlot::notexist = "The slot `` does not exist in the `` object."
  157. ReadOnlySlotQ::dontknow =
  158.     "Cannot determine if slot `` is read-only --  assuming it is."
  159. WriteSlot::readonly = "Can not write to slot `` in a `` object."
  160.  
  161.  
  162. (*  G L O B A L S  *)
  163.  
  164. defaultslotcode = "`1`/: DefaultSlot[`1`[slots__], `2`] := `3`"
  165. SetAttributes[defaultslotcode, {Protected, Locked}]
  166.  
  167.  
  168. (*  S U P P O R T I N G     F U N C T I O N S  *)
  169.  
  170. (*  HasSlotQ  *)
  171. HasSlotQ[h_[objslots__], slot_] := ! SameQ[slot, Replace[slot, {objslots}]]
  172.  
  173. (*  MakeSlot[slotname, value] returns a packet of slot data:    *)
  174. (*  Slot[slotname][value].                    *)
  175. MakeSlot[slotname_, value_] := slotname :> value
  176. MakeSlot[slotname_, value_, rest__] := slotname :> {value, rest}
  177.  
  178. (*  ObjectRead[object, slot] returns the value of slot    *)
  179. ObjectRead[h_[objslots__], slot_] := ReplaceRepeated[slot, {objslots}]
  180. ReadOnlyList/: ObjectRead[h_[objslots__], ReadOnlyList] := 
  181.     Replace[ReadOnlyList, {objslots}]
  182.  
  183. (*  ObjectWrite[object, slot, value] overwrites slot in object with value.  *)
  184. ObjectWrite[object_, slot_, value_] :=
  185.     Block [    {newobj, pos},
  186.         pos = SlotPosition[object, slot];
  187.         If [ pos == 0,
  188.              object,
  189.              newobj = object;
  190.              newobj[[pos]] = MakeSlot[slot, value];
  191.              newobj ] ]
  192.  
  193. (*  SlotPosition[object, slot] returns the index in the  *)
  194. (*  data packet object at which the slot resides.     *)
  195. SlotPosition[object_, slot_] :=
  196.     Block [ {length, pos = 0, searchpattern, slotnum, x},
  197.         searchpattern = MakeSlot[slot, x_];
  198.         length = Length[object];
  199.         For [ slotnum = 1, slotnum <= length, slotnum++,
  200.               If [ MatchQ[ object[[slotnum]], searchpattern ],
  201.                pos = slotnum; Break[] ] ];
  202.         pos ]
  203.  
  204.  
  205. (*  S L O T - B A S E D     F U N C T I O N S  *)
  206.  
  207. (*  All of these function are exported to the global environment  *)
  208.  
  209. (*  Because we will mutate the first argument, set the HoldFirst attribute  *)
  210.  
  211. SetAttributes[AddSlot, {HoldFirst}]
  212. SetAttributes[AppendSlot, {HoldFirst}]
  213. SetAttributes[DefineObjectType, {HoldAll}]
  214. SetAttributes[DeleteSlot, {HoldFirst}]
  215. SetAttributes[MakeObject, {HoldFirst}]
  216. SetAttributes[ReadSlot, {HoldAll}]
  217. SetAttributes[ReadOnlySlotQ, {HoldAll}]
  218. SetAttributes[WriteSlot, {HoldFirst}]
  219.  
  220.  
  221. (*  AddSlot  *)
  222. AddSlot[object_, writeflag_, slot_, initvalue__] :=
  223.     Block [    {newobj, result},
  224.         If [ HasSlotQ[object, slot],
  225.              Message[AddSlot::slotexists, slot, Head[object]];
  226.              Return[object] ];
  227.         newobj = If [ TrueQ[writeflag],
  228.                   object,
  229.                   AppendSlot[object, ReadOnlyList, Append, slot] ];
  230.         object = Sort[ PrependTo[newobj, MakeSlot[slot, initvalue]] ] ]
  231.  
  232. (*  AppendSlot  *)
  233. AppendSlot[object_, slot_, appendfun_, addvalue__ ] :=
  234.     object = If [ HasSlotQ[object, slot],
  235.               WriteSlot[object,
  236.                 slot,
  237.                 appendfun[ReadSlot[object, slot], addvalue]],
  238.               AddSlot[object, True, slot, addvalue] ]
  239.  
  240. (*  DefaultSlot  *)
  241. DefaultSlot[object_Symbol, slot_] :=
  242.     Message[ReadSlot::notexist, slot, object]
  243. DefaultSlot[object_Symbol, slot_, value_] :=
  244.     TagSetDelayed[object, DefaultSlot[object, slot], value]
  245.  
  246.  
  247. (*  DefineObjectType --  operates on value of object not the literal  *)
  248. (*  symbol object so the attributes of Attributes must be changed  *)
  249. DefineObjectType[object_] :=
  250.     Block [ {},
  251.         ClearAttributes[Attributes, HoldAll];
  252.         Attributes[object] = {};
  253.         SetAttributes[object, {HoldRest}];
  254.         SetAttributes[Attributes, HoldAll];
  255.         object ]
  256.  
  257. (*  DeleteSlot --  one can never delete ReadOnlyList  *)
  258. DeleteSlot[object_, slot_] :=
  259.     Block [    {pos, result, slotlist},
  260.         pos = SlotPosition[object, slot];
  261.         Which [ SameQ[pos, 0],
  262.               MyMessage[DeleteSlot::slotmissing, object,
  263.                       slot, Head[object]],
  264.             SameQ[slot, ReadOnlyList],
  265.               MyMessage[DeleteSlot::slotprotected, object,
  266.                       ReadOnlyList, Head[object]],
  267.             True,
  268.               newobj = object;
  269.               If [ ReadOnlySlotQ[newobj, slot],
  270.                    readonlylist = ReadSlot[newobj, ReadOnlyList];
  271.                      newobj = WriteSlot[newobj,
  272.                                  ReadOnlyList,
  273.                           Complement[readonlylist,
  274.                                  {slot}]] ];
  275.               object = Drop[newobj, {pos, pos}] ] ]
  276.  
  277. (*  MakeObject  *)
  278. MakeObject[object_] := object [ MakeSlot[ReadOnlyList, {}] ]
  279.  
  280. (*  ReadSlot  *)
  281. ReadSlot[object_, slot_] := ObjectRead[object, slot] /; HasSlotQ[object, slot]
  282. ReadSlot[object_, slot_] := DefaultSlot[Head[object], slot]
  283.  
  284. (*  ReadOnlySlotQ  *)
  285. ReadOnlySlotQ[object_, slot_] := False /; ! HasSlotQ[object, ReadOnlyList]
  286. ReadOnlySlotQ[object_, slot_] := MemberQ[ReadSlot[object, ReadOnlyList], slot]
  287.  
  288. (*  WriteSlot  *)
  289. WriteSlot[object_, slot_, value__] :=
  290.     Which [ ! HasSlotQ[object, slot],
  291.           object = AddSlot[object, True, slot, value],
  292.         ReadOnlySlotQ[object, slot],
  293.           MyMessage[WriteSlot::readonly, object, slot, Head[object]],
  294.             True,
  295.           object = ObjectWrite[object, slot, value] ]
  296.  
  297.  
  298. (*  E N D     P A C K A G E  *)
  299.  
  300. End[]
  301. EndPackage[]
  302.  
  303. If [ TrueQ[ $VersionNumber >= 2.0 ],
  304.      On[ General::spell ];
  305.      On[ General::spell1 ] ];
  306.  
  307.  
  308. (*  E N D I N G     M E S S A G E  *)
  309.  
  310. Print["Object-oriented extensions loaded."]
  311. Null
  312.